home *** CD-ROM | disk | FTP | other *** search
/ Belgian Amiga Club - ADF Collection / BS1 part 05.zip / BS1 part 5 / PDraw3.0.adf / pdraw_rex.lzh / _PD_TOOLS_RECT.pdrx < prev    next >
Text File  |  1992-06-15  |  2KB  |  99 lines
  1. /*
  2. RECTANGLE TOOL
  3.  
  4. Modifiers:
  5.     ALT will constrain the rectangle to a square
  6.     Double Clicking will bring up a requester which allows you to set
  7.     the dimensions and radius of curvature of the rectangle
  8.  
  9. */
  10. msg = PDSetup.rexx(2,0)
  11. units = getclip(pds_units)
  12. if msg ~= 1 then exit_msg(msg)
  13.  
  14. magic = 0.55228479
  15.  
  16. cr = '0a'x
  17. width = getclip(pduserrectwidth)
  18. height = getclip(pduserrectheight)
  19. radius = getclip(pduserrectradius)
  20.  
  21. if units > 2 then
  22. do
  23.     width = pdm_ConvertUnits(1,units, width)
  24.     height = pdm_ConvertUnits(1,units, height)
  25.     radius = pdm_ConvertUnits(1,units, radius)
  26. end
  27.  
  28. size = pdm_GetForm("Enter size of Rect", 8, "Width:"width || cr"Height:"height ||cr"radius:"radius)
  29. if size = '' then exit_msg()
  30.  
  31. parse var size width '0a'x height '0a'x radius
  32. if radius = '' then radius = 0
  33.  
  34. if ~(datatype(width, n) & datatype(height,n) & datatype(radius,n)) then
  35.     exit_msg("Invalid Entry")
  36.  
  37. if width <= 0 | height <= 0 then
  38.     exit_msg("Invalid Entry")
  39.  
  40. if units > 2 then
  41. do
  42.     width = pdm_ConvertUnits(units,1, width)
  43.     height = pdm_ConvertUnits(units,1, height)
  44.     radius = pdm_ConvertUnits(units,1, radius)
  45. end
  46.  
  47. call setclip(pduserrectwidth, width)
  48. call setclip(pduserrectheight, height)
  49. call setclip(pduserrectradius, radius)
  50.  
  51.  
  52. rect = pdm_ClickRectangle("Click", width, height)
  53. if rect = '' then exit_msg()
  54.  
  55. left = word(rect, 1) - (width / 2)
  56. top = word(rect, 2) - (height / 2)
  57. right = left + width
  58. bottom = top + height
  59.  
  60. if radius = 0 then
  61.     call pdm_DrawRectangle(left, top, right, bottom)
  62. else
  63. do
  64.  
  65.     call pdm_InitPlot()
  66.  
  67.     lxpos = left + radius
  68.     rxpos = right - radius
  69.     typos = top + radius
  70.     bypos = bottom - radius
  71.  
  72.     radlen = radius * magic
  73.     nradlen = -radlen
  74.  
  75.     call pdm_PlotBezier(lxpos" "top" "nradlen" 0 0 0")
  76.     call pdm_PlotBezier(rxpos" "top" 0 0 "radlen" 0")
  77.     call pdm_PlotBezier(right" "typos" 0 "nradlen" 0 0")
  78.     call pdm_PlotBezier(right" "bypos" 0 0 0 "radlen)
  79.     call pdm_PlotBezier(rxpos" "bottom" "radlen" 0 0 0")
  80.     call pdm_PlotBezier(lxpos" "bottom" 0 0 "nradlen" 0")
  81.     call pdm_PlotBezier(left" "bypos" 0 "radlen" 0 0")
  82.     call pdm_PlotBezier(left" "typos" 0 0 0 "nradlen)
  83.     call pdm_PlotBezier(lxpos" "top" "nradlen" 0 0 0")
  84.  
  85.     call pdm_ClosePlot()
  86. end
  87.  
  88. exit_msg()
  89.  
  90. exit_msg: procedure expose units
  91. do
  92.     parse arg message
  93.  
  94.     if message ~= '' then call pdm_Inform(1,message,)
  95.     call pdm_SetUnits(units)
  96.     call pdm_AutoUpdate(1)
  97.     exit
  98. end
  99.